home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / spoolaq.exe / SPOOL2.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-12  |  18KB  |  561 lines
  1. {************************************************}
  2. {                                                }
  3. {   program SPOOL2                               }
  4. {   demo program based on TVGUID15.PAS           }
  5. {   (Copyright (c) 1990 by Borland International)}
  6. {                                                }
  7. {   this program uses the SPOOL-tpu to print     }
  8. {   in the background                            }
  9. {                                                }
  10. {   this is part of SPOOL.EXE                    }
  11. {************************************************}
  12. {$V-}
  13. {$X+}
  14.  
  15. program Spool2;
  16.  
  17. uses Objects, Drivers, Views, Menus, Dialogs, MsgBox, App, Spooler;
  18.  
  19. const
  20.   FileToRead        = 'SPOOL2.PAS';
  21.   MaxLines          = 100;
  22.   WinCount: Integer =   0;
  23.   cmFileOpen        = 100;
  24.   cmNewWin          = 101;
  25.   cmNewDialog       = 102;
  26.   cmFileToSpool     = 103;                       (* !!! added !!! *)
  27.  
  28. var
  29.   LineCount: Integer;
  30.   Lines: array[0..MaxLines - 1] of PString;
  31.  
  32. type
  33.   DialogData = record
  34.     CheckBoxData: Word;
  35.     RadioButtonData: Word;
  36.     InputLineData: string[128];
  37.   end;
  38.  
  39.   TMyApp = object(TApplication)
  40.     MySpooler : PSpooler;
  41.  
  42.     constructor Init;
  43.     destructor  Done;                         virtual;
  44.     procedure HandleEvent(var Event: TEvent); virtual;
  45.     procedure InitMenuBar;                    virtual;
  46.     procedure InitStatusLine;                 virtual;
  47.     procedure Idle;                           virtual;     (* !!! added !!! *)
  48.     procedure FileToSpool;                                 (* !!! added !!! *)
  49.     procedure NewDialog;
  50.     procedure NewWindow;
  51.   end;
  52.  
  53.   PInterior = ^TInterior;
  54.   TInterior = object(TScroller)
  55.     constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  56.     procedure Draw; virtual;
  57.   end;
  58.  
  59.   PDemoWindow = ^TDemoWindow;
  60.   TDemoWindow = object(TWindow)
  61.     RInterior, LInterior: PInterior;
  62.     constructor Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
  63.     function MakeInterior(Bounds: TRect; Left: Boolean): PInterior;
  64.     procedure SizeLimits(var Min, Max: TPoint); virtual;
  65.   end;
  66.  
  67.   PDemoDialog = ^TDemoDialog;
  68.   TDemoDialog = object(TDialog)
  69.   end;
  70.  
  71. procedure ReadFile;
  72. var
  73.   F: Text;
  74.   S: String;
  75. begin
  76.   LineCount := 0;
  77.   Assign(F, FileToRead);
  78.   {$I-}
  79.   Reset(F);
  80.   {$I+}
  81.   if IOResult <> 0 then
  82.   begin
  83.     Writeln('Cannot open ', FileToRead);
  84.     Halt(1);
  85.   end;
  86.   while not Eof(F) and (LineCount < MaxLines) do
  87.   begin
  88.     Readln(F, S);
  89.     Lines[LineCount] := NewStr(S);
  90.     Inc(LineCount);
  91.   end;
  92.   Close(F);
  93. end;
  94.  
  95. procedure DoneFile;
  96. var
  97.   I: Integer;
  98. begin
  99.   for I := 0 to LineCount - 1 do
  100.     if Lines[I] <> nil then DisposeStr(Lines[i]);
  101. end;
  102.  
  103. { TInterior }
  104. constructor TInterior.Init(var Bounds: TRect; AHScrollBar,
  105.   AVScrollBar: PScrollBar);
  106. begin
  107.   TScroller.Init(Bounds, AHScrollBar, AVScrollBar);
  108.   Options := Options or ofFramed;
  109.   SetLimit(128, LineCount);
  110. end;
  111.  
  112. procedure TInterior.Draw;
  113. var
  114.   Color: Byte;
  115.   I, Y: Integer;
  116.   B: TDrawBuffer;
  117. begin
  118.   Color := GetColor(1);
  119.   for Y := 0 to Size.Y - 1 do
  120.   begin
  121.     MoveChar(B, ' ', Color, Size.X);
  122.     i := Delta.Y + Y;
  123.     if (I < LineCount) and (Lines[I] <> nil) then
  124.       MoveStr(B, Copy(Lines[I]^, Delta.X + 1, Size.X), Color);
  125.     WriteLine(0, Y, Size.X, 1, B);
  126.   end;
  127. end;
  128.  
  129. { TDemoWindow }
  130. constructor TDemoWindow.Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
  131. var
  132.   S: string[3];
  133.   R: TRect;
  134. begin
  135.   Str(WindowNo, S);
  136.   TWindow.Init(Bounds, WinTitle + ' ' + S, wnNoNumber);
  137.   GetExtent(Bounds);
  138.   R.Assign(Bounds.A.X, Bounds.A.Y, Bounds.B.X div 2 + 1, Bounds.B.Y);
  139.   LInterior := MakeInterior(R, True);
  140.   LInterior^.GrowMode := gfGrowHiY;
  141.   Insert(Linterior);
  142.   R.Assign(Bounds.B.X div 2, Bounds.A.Y, Bounds.B.X, Bounds.B.Y);
  143.   RInterior := MakeInterior(R,False);
  144.   RInterior^.GrowMode := gfGrowHiX + gfGrowHiY;
  145.   Insert(RInterior);
  146. end;
  147.  
  148. function TDemoWindow.MakeInterior(Bounds: TRect; Left: Boolean): PInterior;
  149. var
  150.   HScrollBar, VScrollBar: PScrollBar;
  151.   R: TRect;
  152. begin
  153.   R.Assign(Bounds.B.X-1, Bounds.A.Y+1, Bounds.B.X, Bounds.B.Y-1);
  154.   VScrollBar := New(PScrollBar, Init(R));
  155.   VScrollBar^.Options := VScrollBar^.Options or ofPostProcess;
  156.   if Left then VScrollBar^.GrowMode := gfGrowHiY;
  157.   Insert(VScrollBar);
  158.   R.Assign(Bounds.A.X+2, Bounds.B.Y-1, Bounds.B.X-2, Bounds.B.Y);
  159.   HScrollBar := New(PScrollBar, Init(R));
  160.   HScrollBar^.Options := HScrollBar^.Options or ofPostProcess;
  161.   if Left then HScrollBar^.GrowMode := gfGrowHiY + gfGrowLoY;
  162.   Insert(HScrollBar);
  163.   Bounds.Grow(-1,-1);
  164.   MakeInterior := New(PInterior, Init(Bounds, HScrollBar, VScrollBar));
  165. end;
  166.  
  167. procedure TDemoWindow.SizeLimits(var Min, Max: TPoint);
  168. var R: TRect;
  169. begin
  170.   TWindow.SizeLimits(Min, Max);
  171.   Min.X := LInterior^.Size.X + 9;
  172. end;
  173.  
  174.  
  175. { TMyApp }
  176. constructor TMyApp.Init;
  177. var
  178.     Rectangle : TRect;
  179. begin
  180.     TApplication.Init;
  181.     MySpooler := nil;
  182. end;
  183.  
  184. destructor TMyApp.Done;
  185. begin
  186.     TApplication.Done;
  187.     if MySpooler<>nil then
  188.         Dispose( MySpooler, Done);
  189. end;
  190.  
  191. procedure TMyApp.HandleEvent(var Event: TEvent);
  192. begin
  193.   TApplication.HandleEvent(Event);
  194.   if Event.What = evCommand then
  195.   begin
  196.     case Event.Command of
  197.       cmNewWin:       NewWindow;
  198.       cmNewDialog:    NewDialog;
  199.       cmFileToSpool : FileToSpool;               (* !!! added !!! *)
  200.     else
  201.       Exit;
  202.     end;
  203.     ClearEvent(Event);
  204.   end;
  205. end;
  206.  
  207. procedure TMyApp.InitMenuBar;
  208. var R: TRect;
  209. begin
  210.   GetExtent(R);
  211.   R.B.Y := R.A.Y + 1;
  212.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  213.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  214.       NewItem('~O~pen', 'F3', kbF3, cmFileOpen, hcNoContext,
  215.       NewItem('~N~ew', 'F4', kbF4, cmNewWin, hcNoContext,
  216.       NewLine(
  217. (*    added: the new entry in the menu: *)
  218.       NewItem('~S~tart Spooling', '', 0, cmFileToSpool, hcNoContext,
  219.       NewLine(
  220.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  221.       nil))))))),
  222.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  223.       NewItem('~N~ext', 'F6', kbF6, cmNext, hcNoContext,
  224.       NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcNoContext,
  225.       NewItem('~D~ialog', 'F2', kbF2, cmNewDialog, hcNoContext,
  226.       nil)))),
  227.     nil))
  228.   )));
  229. end;
  230.  
  231. procedure TMyApp.InitStatusLine;
  232. var R: TRect;
  233. begin
  234.   GetExtent(R);
  235.   R.A.Y := R.B.Y - 1;
  236.   StatusLine := New(PStatusLine, Init(R,
  237.     NewStatusDef(0, $FFFF,
  238.       NewStatusKey('', kbF10, cmMenu,
  239.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  240.       NewStatusKey('~F4~ New', kbF4, cmNewWin,
  241.       NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  242.       nil)))),
  243.     nil)
  244.   ));
  245. end;
  246.  
  247. (* ╔════════════════════════════════════════════════════════════════╗ *)
  248. (* ║                                                                ║ *)
  249. (* ║     added: output the data to the printer                      ║ *)
  250. (* ║                                                                ║ *)
  251. (* ╚════════════════════════════════════════════════════════════════╝ *)
  252. procedure TMyApp.Idle;
  253. begin
  254.     TApplication.Idle;
  255.     if MySpooler<>nil then
  256.         MySpooler^.SpoolOneChar;
  257. end; (* ------------------------------------------- Idle *)
  258.  
  259. (* ╔════════════════════════════════════════════════════════════════╗ *)
  260. (* ║                                                                ║ *)
  261. (* ║     added: which file to spool, which port to use etc.         ║ *)
  262. (* ║                                                                ║ *)
  263. (* ╚════════════════════════════════════════════════════════════════╝ *)
  264. procedure TMyApp.FileToSpool;
  265. type
  266.     SpoolDlgData = record
  267.         FileName    : string[64];
  268.         Port        : word;
  269.         HWAccess    : word;
  270.         Baud        : word;
  271.         Data        : word;
  272.         Stop        : word;
  273.         Parity      : word;
  274.         FlowControl : word;
  275.     end;
  276. var
  277.     Dialog        : PDialog;
  278.     FileName      : PInputLine;
  279.     Rectangle     : TRect;
  280.     Button        : PButton;
  281.     RadioButtons  : PRadioButtons;
  282.     Text          : PStaticText;
  283.     LabelText     : PLabel;
  284.